home *** CD-ROM | disk | FTP | other *** search
/ PC Open 100 / PC Open 100 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / POPFile / Logger.pm < prev    next >
Encoding:
Perl POD Document  |  2004-08-02  |  7.3 KB  |  268 lines
  1. # POPFILE LOADABLE MODULE
  2. package POPFile::Logger;
  3.  
  4. use POPFile::Module;
  5. @ISA = ("POPFile::Module");
  6.  
  7. #----------------------------------------------------------------------------
  8. #
  9. # This module handles POPFile's logger.  It is used to save debugging
  10. # information to disk or to send it to the screen.
  11. #
  12. # Copyright (c) 2001-2003 John Graham-Cumming
  13. #
  14. #   This file is part of POPFile
  15. #
  16. #   POPFile is free software; you can redistribute it and/or modify
  17. #   it under the terms of the GNU General Public License as published by
  18. #   the Free Software Foundation; either version 2 of the License, or
  19. #   (at your option) any later version.
  20. #
  21. #   POPFile is distributed in the hope that it will be useful,
  22. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. #   GNU General Public License for more details.
  25. #
  26. #   You should have received a copy of the GNU General Public License
  27. #   along with POPFile; if not, write to the Free Software
  28. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  29. #
  30. #----------------------------------------------------------------------------
  31.  
  32. use strict;
  33. use warnings;
  34. use locale;
  35.  
  36. # Constant used by the log rotation code
  37. my $seconds_per_day = 60 * 60 * 24;
  38.  
  39. #----------------------------------------------------------------------------
  40. # new
  41. #
  42. #   Class new() function
  43. #----------------------------------------------------------------------------
  44. sub new
  45. {
  46.     my $proto = shift;
  47.     my $class = ref($proto) || $proto;
  48.     my $self = POPFile::Module->new();
  49.  
  50.     # The name of the debug file
  51.  
  52.     $self->{debug_filename__} = '';
  53.  
  54.     # The last ten lines sent to the logger
  55.  
  56.     $self->{last_ten__} = ();
  57.  
  58.     bless($self, $class);
  59.  
  60.     $self->name( 'logger' );
  61.  
  62.     return $self;
  63. }
  64.  
  65. # ---------------------------------------------------------------------------------------------
  66. #
  67. # initialize
  68. #
  69. # Called to initialize the interface
  70. #
  71. # ---------------------------------------------------------------------------------------------
  72. sub initialize
  73. {
  74.     my ( $self ) = @_;
  75.  
  76.     # Start with debugging to file
  77.  
  78.     $self->global_config_( 'debug', 1 );
  79.  
  80.     # The default location for log files
  81.  
  82.     $self->config_( 'logdir', './' );
  83.  
  84.     # The output format for log files, can be default, tabbed or csv
  85.  
  86.     $self->config_( 'format', 'default' );
  87.  
  88.     $self->{last_tickd__} = time;
  89.  
  90.     $self->mq_register_( 'TICKD', $self );
  91.     $self->calculate_today__();
  92.  
  93.     return 1;
  94. }
  95.  
  96. # ---------------------------------------------------------------------------------------------
  97. #
  98. # deliver
  99. #
  100. # Called by the message queue to deliver a message
  101. #
  102. # There is no return value from this method
  103. #
  104. # ---------------------------------------------------------------------------------------------
  105. sub deliver
  106. {
  107.     my ( $self, $type, $message, $parameter ) = @_;
  108.  
  109.     # If a day has passed then clean up log files
  110.  
  111.     if ( $type eq 'TICKD' ) {
  112.         $self->remove_debug_files();
  113.     }
  114. }
  115.  
  116. # ---------------------------------------------------------------------------------------------
  117. #
  118. # service
  119. #
  120. # ---------------------------------------------------------------------------------------------
  121. sub service
  122. {
  123.     my ( $self ) = @_;
  124.  
  125.     $self->calculate_today__();
  126.  
  127.     # We send out a TICKD message every hour so that other modules
  128.     # can do clean up tasks that need to be done regularly but not
  129.     # often
  130.  
  131.     if ( time > ( $self->{last_tickd__} + 60 * 60 ) ) {
  132.         $self->mq_post_( 'TICKD', '', '' );
  133.         $self->{last_tickd__} = time;
  134.     }
  135.  
  136.     return 1;
  137. }
  138.  
  139. # ---------------------------------------------------------------------------------------------
  140. #
  141. # calculate_today - set the global $self->{today} variable to the current day in seconds
  142. #
  143. # ---------------------------------------------------------------------------------------------
  144. sub calculate_today__
  145. {
  146.     my ( $self ) = @_;
  147.  
  148.     # Create the name of the debug file for the debug() function
  149.     $self->{today__} = int( time / $seconds_per_day ) * $seconds_per_day;
  150.     $self->{debug_filename__} = $self->get_user_path_( $self->config_( 'logdir' ) . "popfile$self->{today__}.log", 0 );
  151. }
  152.  
  153. # ---------------------------------------------------------------------------------------------
  154. #
  155. # remove_debug_files
  156. #
  157. # Removes popfile log files that are older than 3 days
  158. #
  159. # ---------------------------------------------------------------------------------------------
  160. sub remove_debug_files
  161. {
  162.     my ( $self ) = @_;
  163.  
  164.     my @debug_files = glob( $self->get_user_path_( $self->config_( 'logdir' ) . 'popfile*.log' ) );
  165.  
  166.     foreach my $debug_file (@debug_files) {
  167.         # Extract the epoch information from the popfile log file name
  168.         if ( $debug_file =~ /popfile([0-9]+)\.log/ )  {
  169.             # If older than now - 3 days then delete
  170.             unlink($debug_file) if ( $1 < (time - 3 * $seconds_per_day) );
  171.         }
  172.     }
  173. }
  174.  
  175. # ---------------------------------------------------------------------------------------------
  176. #
  177. # debug
  178. #
  179. # $message    A string containing a debug message that may or may not be printed
  180. #
  181. # Prints the passed string if the global $debug is true
  182. #
  183. # ---------------------------------------------------------------------------------------------
  184. sub debug
  185. {
  186.     my ( $self, $message ) = @_;
  187.  
  188.     if ( $self->global_config_( 'debug' ) > 0 ) {
  189.  
  190.         # Check to see if we are handling the USER/PASS command and if we are then obscure the
  191.         # account information
  192.  
  193.         $message = "$`$1$3 XXXXXX$4" if ( $message =~ /((--)?)(USER|PASS)\s+\S*(\1)/i );
  194.         $message =~ s/[\012\015]+$//g;
  195.  
  196.         # Since we write to the log file in binmode (so that embedded CR and LF characters
  197.         # are left untouched) we need to add the correct line ending for the platform
  198.         # here.
  199.  
  200.         if ( $^O =~ /MSWin/i ) {
  201.             $message .= "\015\012";
  202.     } else {
  203.             if ( $^O =~ /Mac/i ) {
  204.                 $message .= "\015";
  205.         } else {
  206.                 $message .= "\012";
  207.         }
  208.     }
  209.  
  210.         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime;
  211.         $year += 1900;
  212.         $mon  += 1;
  213.  
  214.         $min  = "0$min"  if ( $min  < 10 );
  215.         $hour = "0$hour" if ( $hour < 10 );
  216.         $sec  = "0$sec"  if ( $sec  < 10 );
  217.    
  218.         my $delim = ' ';
  219.         $delim = '\t' if ( $self->config_( 'format' ) eq 'tabbed' );
  220.         $delim = ',' if ( $self->config_( 'format' ) eq 'csv' );
  221.  
  222.         my $msg = "$year/$mon/$mday$delim$hour:$min:$sec$delim$$:$delim$message";
  223.  
  224.         if ( $self->global_config_( 'debug' ) & 1 )  {
  225.           if ( open DEBUG, ">>$self->{debug_filename__}" ) {
  226.                 binmode DEBUG;
  227.                 print DEBUG $msg;
  228.                 close DEBUG;
  229.             }
  230.         }
  231.  
  232.         print $msg if ( $self->global_config_( 'debug' ) & 2 );
  233.  
  234.         # Add the line to the in memory collection of the last ten
  235.         # logger entries and then remove the first one if we now have
  236.         # more than 10
  237.  
  238.         push @{$self->{last_ten__}}, ($msg);
  239.  
  240.         if ( $#{$self->{last_ten__}} > 9 ) {
  241.             shift @{$self->{last_ten__}};
  242.         }
  243.     }
  244. }
  245.  
  246. # GETTERS/SETTERS
  247.  
  248. sub debug_filename
  249. {
  250.     my ( $self ) = @_;
  251.  
  252.     return $self->{debug_filename__};
  253. }
  254.  
  255. sub last_ten
  256. {
  257.     my ( $self ) = @_;
  258.  
  259.     if ( $#{$self->{last_ten__}} >= 0 ) {
  260.         return @{$self->{last_ten__}};
  261.     } else {
  262.         my @temp = ( 'log empty' );
  263.         return @temp;
  264.     }
  265. }
  266.  
  267. 1;
  268.